home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 098 / eds.arc / EDSCH.LSP < prev    next >
Encoding:
Text File  |  1987-02-15  |  902 b   |  25 lines
  1. (defun c:ch ()
  2.   (command "osnap" "end")
  3.   (setq pnt1 (getpoint "\nSelect upper-left end : "))
  4.   (setq pnt2 (getpoint "\nSelect lower-left corner : "))
  5.   (setq pnt3 (getpoint "\nSelect lower-right end : "))
  6.   (setq vs (getreal "\nGreatest Y-Axis value : "))
  7.   (setq nbars (getint "\nNumber of bars : "))
  8.   (setq vl (- (cadr pnt1) (cadr pnt2)))
  9.   (setq hl (- (car pnt3) (car pnt2)))
  10.   (setq dxbars (/ hl (1+ (* nbars 2))))
  11.   (setq vscale (/ vl vs))
  12.   (setq count 1)
  13.   (while (< count nbars)
  14.     (prin1 "\nValue of bar #)
  15.     (prin1 count)
  16.     (setq barval (getreal))
  17.     (setq xval (- (* dxbars (* count 2)) dxbars))
  18.     (seqt pta (list xval (cadr pnt2)))
  19.     (setq ptc (list (+ (car pta) dxbars) (* barval vscale)))
  20.     (setq ptb (list (car ptc) (cadr pta)))
  21.     (setq ptd (list (car pta) (cadr ptc)))
  22.     (command "pline" pta ptb ptc ptd "c")
  23.     (setq count (1+ count))
  24.   )
  25. )